home *** CD-ROM | disk | FTP | other *** search
/ Developer CD Series 1993…ch: Other People's Memory / ADC Developer CD (1993-03) (''Other People's Memory'')_iso / Dev.CD Mar 93.iso / Development Platforms / LISP Related / LISP Goodies / McCartney-library 1.1 / CODE / views / pop-up-view-button.lisp < prev    next >
Encoding:
Text File  |  1992-09-02  |  1.4 KB  |  63 lines  |  [TEXT/CCL2]
  1. ;;; pop-up-view-button.lisp
  2. ;;;
  3. ;;; Paul McCartney, Spring 1992
  4. ;;;
  5. ;;; Copyright © 1992 Paul McCartney.  All Rights Reserved.
  6. ;;; 
  7. ;;; Washington University Medical Informatics Training Program
  8. ;;;
  9. ;;; DESCRIPTION:
  10. ;;;
  11. ;;; This is a specialized button.  When it is pressed, a pop up view
  12. ;;; is displayed containing user defined graphics and text.
  13. ;;;
  14. ;;; USE:
  15. ;;;
  16. ;;; pop-up-view-button
  17. ;;;
  18. ;;; HISTORY:
  19. ;;;
  20. ;;; 7/30/92 Created.  - PM
  21. ;;;
  22.  
  23. (in-package :ccl)
  24.  
  25. (require :pop-up-view)
  26.  
  27. (export '(pop-up-view-button)
  28.         :ccl)
  29.  
  30.  
  31. (defclass pop-up-view-button (button-dialog-item pop-up-view)
  32.   () )
  33.  
  34.  
  35. (defmethod view-click-event-handler ((puvb pop-up-view-button) where)
  36.   (declare (ignore where))
  37.   (puv-display puvb (view-container puvb)))
  38.  
  39.  
  40. #|
  41. (require :quickdraw)
  42.  
  43. (puv-init)
  44. ; (puv-destroy)
  45.  
  46. (defun sample-draw-fn (view size data)
  47.   (declare (ignore data))
  48.   (with-fore-color *blue-color*
  49.     (paint-oval view #@(10 10) (subtract-points size #@(10 10)) )))
  50.  
  51. (defvar w)
  52. (setf w 
  53.       (make-instance 'window
  54.         :color-p t
  55.         :view-subviews 
  56.         (list (make-instance 'pop-up-view-button
  57.                 :dialog-item-text "Press me"
  58.                 :view-position #@(20 20)
  59.                 :pop-up-view-size #@(50 50)
  60.                 :pop-up-view-draw-fn #'sample-draw-fn
  61.                 :color-list (list :frame *green-color*
  62.                                   :background *yellow-color*))) ))
  63. |#